home *** CD-ROM | disk | FTP | other *** search
Text File | 1994-07-26 | 2.6 KB | 77 lines | [TEXT/gamI] |
- ; This is a small demo that shows how to interface to the "high-level"
- ; window manager. Events generated for the sample window are simply
- ; displayed as they are received.
-
- (define (make-sample-window rect name)
-
- ; First, create the Macintosh window
-
- (let ((w (mac#newwindow rect name #t 4 -1 #t)))
-
- ; These procedures handle the events generated by the Macintosh
-
- (define (mousedown pt modifiers) (show "mousedown" #f modifiers pt))
- (define (mouseup pt modifiers) (show "mouseup" #f modifiers pt))
- (define (keydown ch modifiers) (show "keydown" ch modifiers #f))
- (define (keyup ch modifiers) (show "keyup" ch modifiers #f))
- (define (autokey ch modifiers) (show "autokey" ch modifiers #f))
- (define (goaway) (bye))
- (define (update) (show "update" #f #f #f))
- (define (activate) (show "activate" #f #f #f))
- (define (deactivate) (show "deactivate" #f #f #f))
-
- ; Utilities for above
-
- (define event-count 0)
-
- (define (show event-name char modifiers pt)
- (set! event-count (+ event-count 1))
- (mac#eraserect w (mac#rect -32000 -32000 32000 32000))
- (mac#moveto w 10 20)
- (mac#drawstring w "event #")
- (mac#drawstring w (number->string event-count))
- (mac#drawstring w ": ")
- (mac#drawstring w event-name)
- (if char
- (begin
- (mac#drawstring w " ")
- (mac#drawchar w char)))
- (if modifiers
- (begin
- (mac#drawstring w " ")
- (mac#drawstring w (number->string modifiers))))
- (if pt
- (let ((h (mac#point-h pt)) (v (mac#point-v pt)))
- (mac#lineto w h v)
- (mac#paintoval w (mac#rect (- v 3) (- h 3) (+ v 3) (+ h 3))))))
-
- (define (bye)
- (mac#window-unbind w)
- (mac#disposewindow w))
-
- ; Create high-level window object
-
- (define (wind msg)
- (case msg
- ((MOUSEDOWN) mousedown)
- ((MOUSEUP) mouseup)
- ((KEYDOWN) keydown)
- ((KEYUP) keyup)
- ((AUTOKEY) autokey)
- ((GOAWAY) goaway)
- ((UPDATE) update)
- ((ACTIVATE) activate)
- ((DEACTIVATE) deactivate)
- (else (error "Unknown window message:" msg))))
-
- ; If window was created, announce its presence to the window manager
-
- (if (= w 0)
- (error "Window could not be created (out of memory?)")
- (begin
- (mac#window-bind w wind)
- wind))))
-
- (make-sample-window (mac#rect 130 10 330 310) "Sample 2")
- (make-sample-window (mac#rect 50 200 250 500) "Sample 1")
-